home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 051-075 / disk_074 / funds / fund next >
Text File  |  1992-05-06  |  19KB  |  528 lines
  1.  
  2. '             Mutual Fund Performance Program  -- version 1.1
  3. '
  4. '  This program reads user inputted price data for mutual funds (or stocks)
  5. '  and creates a table of such data which can be printed to detect trends
  6. '  and performance history.  It stores the data in a file named by the
  7. '  user -- the default file name is MutualFunds, assumed to be in the
  8. '  current directory.  Funds, dates, & prices may be added, deleted,
  9. '  modified, & resequenced thru mouse-driven menus.  The example MutualFunds
  10. '  file contains weekly price data for several funds.
  11. '  See PrintData: comments to reset printer margins, line width, type style.
  12. '  
  13. '  By Bill Strack, Strongsville, Ohio, CA-AUG/BBS (tele. 216-341-4452).
  14. '
  15. CLEAR,40000&,9000&
  16. DEFINT i-n
  17. DIM f$(39),d$(100),p(100,39),pb(39),pl(39),ib(39)
  18. PRINT "Read source code header for a description of this program.": PRINT
  19. filename$="MutualFunds"
  20.   
  21. GetFile:
  22. ON ERROR GOTO trouble
  23. CALL requester ("Input data filename", filename$, "OK", b%)
  24. OPEN "I",#1,filename$: INPUT #1,nfunds,ndates
  25. PRINT "Reading input data from " filename$  " ... ";
  26. FOR i=1 TO nfunds: INPUT #1,f$(i): NEXT
  27. FOR i=1 TO ndates: INPUT #1,d$(i): NEXT 
  28. FOR i=1 TO ndates: FOR j=1 TO nfunds
  29. INPUT #1, p(i,j): NEXT j,i: CLOSE #1
  30. PRINT "successfully read.": PRINT 
  31. true=1: false=0: incre=false: istart=1
  32. PRINT "Select item from menu using mouse."
  33. MENU 5,0,1,"  Menu choices:"
  34. MENU 5,1,1,"  Add fund"
  35. MENU 5,2,1,"  Delete fund"
  36. MENU 5,3,1,"  Relocate fund"
  37. MENU 5,4,1,"  Add date & prices"
  38. MENU 5,5,1,"  Delete date"
  39. MENU 5,6,1,"  Change fund name"
  40. MENU 5,7,1,"  Change date"
  41. MENU 5,8,1,"  Change price"
  42. MENU 5,9,1,"  Delete file"
  43. MENU 5,10,1,"  Display data - incremental"
  44. MENU 5,11,1,"  Display data"
  45. MENU 5,12,1,"  Print data - incremental"
  46. MENU 5,13,1,"  Print data"
  47. MENU 5,14,1,"  Save data"
  48. MENU 5,15,1,"  Quit"
  49. ON MENU GOSUB MenuCheck
  50.              
  51. idle: 
  52.      MENU ON: GOTO idle
  53.       
  54. MenuCheck:
  55.   MENU 5,item,1: item = MENU(1): MENU 5,item,2
  56.   IF item < 9 THEN update=true: BREAK ON: ON BREAK GOSUB Quit
  57.   ON item GOSUB AddFund,DeleteFund,RelocateFund,AddPrices,DeleteDate,ChangeFundName,ChangeDate,ChangePrice,DeleteFile,DisplayData.incre,DisplayData,PrintData.incre,PrintData,SaveData,Quit
  58.   PRINT "Select another option from the main menu.": PRINT
  59.   GOSUB idle
  60.     
  61. AddFund:   f$ = "\12"
  62.   CALL requester ("Enter NAME of new fund", f$ ,"Add\Cancel", b%)
  63.   IF b% = 1 THEN nfunds = nfunds + 1: f$(nfunds)=f$+SPACE$(12-LEN(f$))
  64.   RETURN
  65.  
  66. DeleteFund:
  67.   GOSUB Fund
  68.   CALL requester ("Delete fund " + f$ + " ?", "", "Yes\No", b%)
  69.   IF b% = 1 THEN   
  70.     FOR i = jfund TO nfunds: f$(i) = f$(i+1)
  71.     FOR j = 1 TO ndates: p(j,i) = p(j,i+1): NEXT j,i
  72.     nfunds = nfunds - 1: PRINT f$ " deleted."
  73.   END IF 
  74.   RETURN 
  75.     
  76. RelocateFund:
  77.   GOSUB Fund: mfund = jfund: PRINT f$ " to be relocated."
  78.   PRINT "Select fund to the right of insertion point:  ";: GOSUB Fund
  79.   IF jfund = mfund THEN PRINT "Null move invalid": RETURN
  80.   f$(39) = f$(mfund): FOR k=1 TO ndates: p(k,39) = p(k,mfund): NEXT
  81.   IF jfund > mfund THEN
  82.     FOR j = mfund+1 TO jfund-1: f$(j-1) = f$(j)
  83.     FOR k = 1 TO ndates: p(k,j-1) = p(k,j): NEXT k,j
  84.     f$(jfund-1) = f$(39): FOR k=1 TO ndates: p(k,jfund-1) = p(k,39): NEXT k
  85.    ELSE
  86.     FOR j = mfund-1 TO jfund STEP -1: f$(j+1) = f$(j)
  87.     FOR k = 1 TO ndates: p(k,j+1) = p(k,j): NEXT k,j
  88.     f$(jfund) = f$(39): FOR k=1 TO ndates: p(k,jfund) = p(k,39): NEXT k
  89.    END IF
  90.   PRINT "Relocation completed."
  91.   RETURN
  92.               
  93. AddPrices:
  94.   lastdate$ = d$(ndates) + "\9"
  95.   message$ = "Last date entry is " + d$(ndates) + "\\Enter NEW Date:"
  96.   CALL requester (message$, lastdate$, "Enter\Cancel", b%)
  97.   IF b% = 1 THEN ndates = ndates + 1: d$(ndates) = lastdate$ ELSE RETURN
  98.   PRINT "Enter Prices:"
  99.   FOR i = 1 TO nfunds
  100.     p$=" \6\real": PRINT f$(i);
  101.     PRINT USING ": Last price=###.##"; p(ndates-1,i);: PRINT  " ";
  102.   CALL requester ("", p$,"", b%)
  103.     IF b% <> 0 THEN
  104.       p(ndates,i) = VAL(p$) 
  105.     ELSE
  106.       d$(ndates) = ""
  107.       FOR j = 1 TO i-1: p(ndates,j) = 0: NEXT 
  108.       ndates = ndates - 1: RETURN
  109.     END IF
  110.   NEXT i: RETURN
  111.     
  112. DeleteDate:
  113.   GOSUB Date 
  114.   CALL requester ("Delete date " + d$ + " ?", "", "Yes\No", b%)
  115.   IF b% = 1 THEN 
  116.     FOR j = jdate TO ndates: d$(j) = d$(j+1)
  117.     FOR i = 1 TO nfunds: p(j,i) = p(j+1,i): NEXT i,j
  118.     ndates = ndates - 1: PRINT d$ " deleted."
  119.   END IF
  120.   RETURN
  121.     
  122. ChangeFundName:
  123.   GOSUB Fund: f$ = f$(jfund)+"\12"
  124.   CALL requester ("Change fund name:", f$, "Change\Cancel", b%)
  125.   IF b% = 1 THEN f$(jfund) = f$ + SPACE$(12-LEN(f$(jfund)))
  126.   RETURN
  127.     
  128. ChangeDate:
  129.   GOSUB Date: d$ = d$(jdate) + "\9
  130.   CALL requester ("Change the date:", d$, "Change\Cancel", b%)
  131.   IF b% = 1 THEN d$(jdate) = d$
  132.   RETURN
  133.     
  134. ChangePrice:
  135.   GOSUB Fund: GOSUB Date: p$ = STR$(p(jdate,jfund)) + "\6\real"
  136.   message$ = "Enter new price for " + f$ + " fund on " + d$
  137.   CALL requester (message$, p$, "Change\Cancel", b%)
  138.   IF b% = 1 THEN p(jdate,jfund) = VAL(p$)
  139.   RETURN
  140.                               
  141. DeleteFile:
  142.   ON ERROR GOTO errorfile: file$ = "\40"
  143.   CALL requester ("Enter filename to delete: ", file$, "Delete\Cancel", b%)
  144.   IF b% = 1 THEN KILL file$
  145.   RETURN
  146.   errorfile:
  147.   IF ERR = 53 THEN PRINT "File " file$ " not found.": RESUME NEXT
  148.         
  149. DisplayData.incre:
  150.   incre = true
  151. DisplayData: 
  152.   message$ = "There are " + STR$(ndates) + " dates in the data table."    
  153.   IF a$ = "P" THEN
  154.     message$ = message$ +  "\How many should be printed? "
  155.     nd$ = "All\5\integer"
  156.     CALL requester (message$, nd$, "Print\Cancel", b%)
  157.     IF nd$ = "All" OR VAL(nd$) <= 0 THEN nd = ndates ELSE nd = VAL(nd$)
  158.   ELSE
  159.     OPEN "O",#2,"SCRN:": jj=8: t=30
  160.     message$ = message$ + "\How many should be displayed? "
  161.     nd$ = "15\5\integer"
  162.     CALL requester (message$, nd$, "Display\Cancel", b%): nd = VAL(nd$)
  163.     IF nd <= 0 THEN nd = 15
  164.   END IF
  165.   IF b% <> 1 THEN End.List
  166.   IF nd > ndates THEN nd = ndates
  167.   IF a$ <> "P" THEN CLS ELSE PRINT "Printing data ... ";
  168.   PRINT #2, TAB(t); "Mutual Fund Performance": j1=1
  169.   loop: PRINT #2, "": j2 = j1 + jj: IF j2 > nfunds THEN j2 = nfunds
  170.   PRINT #2, TAB(9);: FOR j = j1 TO j2: pb(j) = 0!
  171.   PRINT #2, LEFT$(f$(j),6) + "  ";: NEXT j: PRINT #2, ""
  172.   PRINT #2, TAB(9);: FOR j = j1 TO j2
  173.   PRINT #2, RIGHT$(f$(j),6) + "  ";: NEXT j: PRINT #2, ""
  174.   idate = ndates - nd + 1: oldyear$ = ""
  175.   FOR i = idate TO ndates
  176.     year$ = RIGHT$(d$(i),2)
  177.     IF year$ <> oldyear$ THEN
  178.       IF oldyear$ <> "" THEN PRINT #2, "":
  179.       PRINT #2, "19" year$: oldyear$ = year$
  180.     END IF
  181.     PRINT #2, LEFT$(d$(i),6) " ";
  182.     FOR j=j1 TO j2: logi = p(i,j) <> 0! AND pb(j) = 0!
  183.     IF logi THEN pb(j) = p(i,j): pl(j) = pb(j): ib(j) = i
  184.     IF p(i,j) = 0! THEN PRINT #2, SPACE$(8);: GOTO NextFund
  185.     IF incre AND i > ib(j) THEN
  186.            PRINT #2, USING " +##.## "; (p(i,j)/pl(j)-1!)*100!;
  187.            pl(j)=p(i,j)
  188.         ELSE
  189.            PRINT #2, USING " ###.## "; p(i,j);
  190.           END IF
  191.           
  192.       NextFund:          
  193.       NEXT j: PRINT #2, "": NEXT i: PRINT #2, ""
  194.     PRINT #2, " Total ";: FOR j=j1 TO j2: k=ndates
  195.     WHILE p(k,j) = 0! 
  196.       k=k-1
  197.     WEND
  198.     PRINT #2, USING "+###.#% "; (p(k,j)/pb(j)-1!)*100!;
  199.     NEXT j: PRINT #2, ""
  200.     IF a$ <> "P" AND j2 < nfunds THEN
  201.      INPUT "Press RETURN to continue listing funds or S to stop. ", a$
  202.      IF UCASE$(a$) = "S" THEN End.List
  203.     END IF   
  204.     IF j2 < nfunds THEN j1 = j2 + 1: PRINT #2, "": GOTO loop
  205.     
  206.   End.List:
  207.     IF a$ = "P" THEN PRINT #2, CHR$(27)"c": PRINT "completed." 
  208.     CLOSE #2: a$ = "": incre = false: RETURN
  209.     
  210. PrintData.incre:
  211.    incre=true
  212.      
  213. PrintData:
  214.    ' Set print style to elite condensed fine, margins: left-1, right-160
  215.    OPEN "O",#2,"PRT:": PRINT #2, CHR$(27)"[4w";CHR$(27)"[2w"
  216.    PRINT #2, CHR$(27)"[1;160s"
  217.    PRINT #2, "": a$ = "P": jj = 18: t = 60: GOTO DisplayData
  218.                                                
  219. SaveData:
  220.    message$ = "Enter filename to save data:"
  221.    CALL requester (message$, filename$, "Save\Cancel", b%)
  222.    IF b% <>1 THEN RETURN
  223.    PRINT "Storing data in "+filename$+" -- ";
  224.    ON ERROR GOTO trouble
  225.    OPEN "O",#1,filename$
  226.    WRITE #1, nfunds,ndates
  227.    FOR i=1 TO nfunds: WRITE #1, f$(i): NEXT i
  228.    FOR i=1 TO ndates: WRITE #1, d$(i): NEXT i
  229.    FOR i=1 TO ndates: FOR j=1 TO nfunds
  230.    WRITE #1, p(i,j): NEXT j,i: CLOSE #1: update=false
  231.    PRINT "data stored successfully.": RETURN
  232. trouble:
  233.   IF ERR = 53 THEN PRINT "File " filename$ " not found.": RESUME GetFile
  234.   IF ERR = 61 THEN PRINT "save cancelled - disk is full.": RESUME tag
  235.   IF ERR > 49 AND ERR < 75 THEN PRINT "cancelled - error " ERR: RESUME tag
  236.   tag:   ON ERROR GOTO 0: CLOSE #1: RETURN       
  237.                                                                  
  238. Quit:
  239.   IF update THEN
  240.     message$ = "You modified the data set.\Don't you want to save it?"
  241.     CALL requester (message$, "", "Yes\No", b%)
  242.     IF b% = 1 THEN GOSUB SaveData
  243.   END IF                                        
  244.   CLOSE: MENU RESET
  245.   END
  246.  
  247. Fund:
  248.   PRINT "Select fund from menus."
  249.   MENU 6,0,1,"Funds"
  250.   MENU 7,0,1,"Page funds"
  251.   MENU 7,1,1,"  go forward": MENU 7,2,1,"  go backward"
  252.     IF fstart = 0 THEN fstart = 1: fend=1
  253.     f$ = "": GOSUB Listf : ON MENU GOSUB Fund1
  254.     WHILE f$ = ""
  255.       MENU ON
  256.     WEND: RETURN
  257.   Fund1:
  258.     MEN0 = MENU(0): MEN1 = MENU(1) 
  259.     IF MEN0 = 5 THEN GOTO MenuCheck
  260.        IF MEN0 = 6 THEN
  261.          jfund = MEN1 + fstart-1: f$ = f$(jfund)
  262.           MENU 6,0,0: MENU 7,0,0: RETURN
  263.        ELSE ' men0 = 3
  264.          IF MEN1 = 1 AND nfunds > fend THEN
  265.             fstart = fstart + 19: GOSUB Listf
  266.          ELSEIF MEN1 = 2 AND fstart > 19 THEN
  267.             fstart = fstart - 19: GOSUB Listf
  268.          ELSE
  269.             BEEP: CALL requester ("List request out of range.", "", "",b%)
  270.          END IF
  271.        END IF  
  272.        RETURN
  273.        
  274.        Listf:
  275.          j = 1: fend = fstart + 18
  276.          FOR i = fstart TO fend
  277.          MENU 6,j,1,f$(i): j = j+1: NEXT
  278.          RETURN
  279.          END        
  280.              
  281. Date:
  282.   PRINT "Select date from DATES menu."
  283.   MENU 6,0,1,"Dates"
  284.   MENU 7,0,1,"Page dates"
  285.   MENU 7,1,1,"go forward": MENU 7,2,1,"go backward"
  286.   IF dstart = 0 THEN dstart = 1: dend = 1
  287.   d$ = "": GOSUB Listd : ON MENU GOSUB Date1
  288.   WHILE d$ = ""
  289.     MENU ON
  290.   WEND: RETURN
  291.   
  292.   Date1: MEN0 = MENU(0): MEN1 = MENU(1) 
  293.          IF MEN0 = 5 THEN GOTO MenuCheck
  294.          IF MEN0 = 6 THEN
  295.            jdate = MEN1 + dstart - 1: d$ = d$(jdate)
  296.            MENU 6,0,0: MENU 7,0,0: RETURN
  297.          ELSE ' men0 = 5
  298.            IF MEN1 = 1 AND ndates > dend THEN
  299.              dstart = dstart + 19: GOSUB Listd
  300.            ELSEIF MEN1 = 2 AND dstart > 19 THEN
  301.              dstart = dstart - 19: GOSUB Listd
  302.            ELSE
  303.              BEEP: CALL requester("List request out of range.","","",b%)
  304.            END IF
  305.          END IF  
  306.          RETURN
  307.           
  308.   Listd: j = 1: dend = dstart + 18
  309.          FOR i = dstart TO dend
  310.          MENU 6,j,1,d$(i): j = j+1: NEXT
  311.          RETURN
  312.          END '_____________________________________________________________
  313.                  
  314.   
  315. '   A general purpose requester routine with n-buttons and a string gadget.
  316. '    
  317. '     Message$ = Text displayed at top of requester  ("\" separates lines)
  318. '       InOut$ = String gadget initialized by calling program. 
  319. '                Default length is 40 characters, but may be altered by
  320. '                appending "\MaxLength" to initial value of InOut$.
  321. '                Also, append "\real" or "\integer" to receive a real or 
  322. '                integer value rather than a string, and use a VAL(InOut$)
  323. '                command after your CALL.
  324. ' ButtonLabel$ = Button labels, user clicks a button or types first 
  325. '                letter of label to select
  326. '      Button% = Button number clicked by user, returned to caller.
  327.                  Zero is returned IF user presses ESCAPE key.
  328.  
  329. '   Example usage: 
  330.                 
  331. '  Message$ =  "The data must be stored on disk.\What filename should be used?"
  332. '  InOut$   =  "df1:filename"
  333. '  ButtonLabel$ =  "Store\Help\Cancel"
  334. '                  
  335. '  CALL Requester (Message$, InOut$, ButtonLabel$, Button%)
  336. '  PRINT Button%: PRINT InOut$: END
  337.  
  338. '   By Bill Strack, CA-AUG, Cleveland, OH  (public domain).
  339.  
  340. SUB requester (message$, inout$, ButtonLabel$, button%) STATIC
  341.   real$="R": integer$="I": stringarray$(1)="": type$="string"
  342.   sep$="\"
  343.   
  344.   ' Separate strings into parts
  345.   FOR i=1 TO 10: text$(i)="": button$(i)="": NEXT
  346.   FOR i=1 TO 3:  stringarray$(i)="": NEXT
  347.   CALL StringSep (message$, sep$, text$(), n.texts)
  348.   CALL StringSep (inout$, sep$, stringarray$(), n.strings)
  349.   CALL StringSep (ButtonLabel$, sep$, button$(), n.buttons)
  350.   StringGadget = inout$ <> ""
  351.   IF StringGadget THEN
  352.     defaultstring$ = stringarray$(1): len.string = LEN(defaultstring$)
  353.     IF stringwidth < 0 OR stringwidth > 40 THEN stringwidth = 40
  354.     IF stringwidth < len.string THEN stringwidth = len.string
  355.   END IF
  356.   IF stringarray$(2) = "" THEN stringwidth = 40 ELSE stringwidth = VAL(stringarray$(2))
  357.   IF UCASE$(LEFT$(stringarray$(3),1)) = real$ THEN type$ = real$
  358.   IF UCASE$(LEFT$(stringarray$(3),1)) = integer$ THEN type$ = integer$
  359.   IF n.texts + n.buttons = 0 THEN DisplayString
  360.  
  361.   ' Determine size of requester window 
  362.   wide = 0: buttonlength = 0
  363.   FOR i = 1 TO n.texts
  364.     lt = LEN(text$(i))+2: IF lt > wide THEN wide = lt: NEXT
  365.   ltext = wide
  366.   FOR i=1 TO n.buttons
  367.     buttonlength = LEN(button$(i))+buttonlength: NEXT
  368.   lb = buttonlength + 6*n.buttons
  369.   IF lb > wide THEN wide = lb
  370.   high = n.texts + 3: IF n.buttons > 0 THEN high = high + 2
  371.   IF StringGadget THEN 
  372.     high = high + 3
  373.     IF stringwidth > wide THEN wide = stringwidth + 4
  374.   END IF
  375.   
  376.   ' Open requester window after checking required dimensions
  377.   delta.w = WINDOW(2)/8-wide: delta.h = WINDOW(3)/8-high
  378.   IF delta.w < 0 THEN PRINT "Requester width" ABS(delta.w) "characters too long."
  379.   IF delta.h < 0 THEN PRINT "Requester height" ABS(delta.h) "lines too long."
  380.   IF delta.w < 0 OR delta.h < 0 THEN PRINT "Stopped due to sizing error.": STOP
  381.   x1 = delta.w\2: y1 = delta.h\2: x2 = x1+wide: y2 = y1+high
  382.   WINDOW 100,,(x1*8,y1*8)-(x2*8,y2*8),0: COLOR 2,1
  383.   LINE (0,0)-(WINDOW(2),WINDOW(3)),1,bf 
  384.   
  385.   ' Display requester text
  386.   IF n.texts <> 0 THEN
  387.     j = 0: FOR i = 1 TO n.texts: j = j+1
  388.     LOCATE j+1,(wide-ltext)\2+2: PRINT text$(i): NEXT
  389.   END IF  
  390.     
  391.   ' Display requester buttons
  392.   IF n.buttons <> 0 THEN
  393.     buttonspace = (wide-buttonlength)\n.buttons
  394.     LOCATE high-1,(wide-buttonlength-(n.buttons-1)*buttonspace)\2+1
  395.     yb1 = (CSRLIN-2)*8: yb2 = yb1+24
  396.     FOR b = 1 TO n.buttons          
  397.     xb1(b) = (POS(o)-2)*8: xb2(b) = xb1(b) + (LEN(button$(b))+2)*8
  398.     LINE (xb1(b),yb1)-(xb2(b),yb2),2,b
  399.     LINE (xb1(b)-1,yb1-1)-(xb2(b)+1,yb2+1),3,b
  400.     PRINT button$(b);: LOCATE ,POS(o)+buttonspace: NEXT
  401.   END IF  
  402.   
  403.   'Branch to user response routines
  404.   IF StringGadget THEN
  405.     GOTO DisplayString
  406.   ELSEIF n.buttons <> 0 THEN
  407.     WHILE 1: GOSUB check.buttons: WEND
  408.   ELSE
  409.     LOCATE n.texts+3,1: PRINT " Press RETURN to continue."
  410.     WHILE 1
  411.       k$ = INKEY$: IF k$ <> "" THEN IF ASC(k$) = 13 THEN exit.requester
  412.     WEND
  413.   END IF
  414.          
  415.  
  416.   DisplayString:   ' Display input string gadget
  417.   asc.low = 32: asc.high = 125  ' set ASCII limits
  418.   IF n.texts + n.buttons <> 0 THEN
  419.     LOCATE j+3,(wide-stringwidth)\2 + 1: fg=1: bg=0
  420.   ELSE
  421.     fg= 0: bg=1
  422.   END IF
  423.   y = CSRLIN: x = POS(o): maxline = 22: COLOR fg,bg
  424.   IF y > maxline THEN
  425.     SCROLL (0,0)-(WINDOW(2),WINDOW(3)),0,-8*(y-maxline)
  426.     LINE (0,maxline*8)-(WINDOW(2),WINDOW(3)),fg,bf
  427.     y=maxline: LOCATE y
  428.   END IF
  429.   a$ = defaultstring$: strlength = LEN(a$)
  430.   cursor = LEN(a$): IF cursor = stringwidth THEN cursor = cursor - 1 
  431.   LINE (x*8-12,y*8-9)-(8*(x+stringwidth)+3,8*y),bg,bf
  432.  
  433.   display.line:
  434.     LOCATE y,x: PRINT a$+SPACE$(stringwidth-LEN(a$))
  435.   
  436.   GetNewString:
  437.     IF MOUSE(0) <> 0 AND n.buttons > 0 THEN GOSUB IdentifyButton
  438.     k$ = INKEY$
  439.     count = count-1  ' delete for non-flashing cursor
  440.     IF count <= 0 AND cursor < stringwidth THEN
  441.       x1=8*(x+cursor)-8: y1=y*8-8: x2=x1+8: y2=y1+7
  442.       AREA (x1,y1): AREA (x2,y1): AREA (x2,y2): AREA (x1,y2)
  443.       AREAFILL 1
  444.       count = 100  ' set cursor flash rate
  445.       END IF
  446.     IF k$ = "" THEN GetNewString
  447.     k = ASC(k$): count = 0
  448.     IF k=27 THEN button% = 0: GOTO exit.requester 'escape
  449.     IF k=13 THEN done.getnewstring  ' return key pressed
  450.     IF k >= asc.low AND k <= asc.high AND strlength < stringwidth THEN
  451.       IF type$=real$ OR type$=integer$ THEN  
  452.         IF k<43 OR k>57 OR k=44 OR k=47 THEN GetNewString
  453.         IF (k=43 OR k=45) AND cursor>0 THEN GetNewString
  454.         IF type$=integer$ AND k=46 THEN GetNewString
  455.       END IF
  456.       LOCATE y,x+cursor: strlength = strlength+1
  457.       a$ = LEFT$(a$,cursor)+k$+MID$(a$,cursor+1): PRINT MID$(a$,cursor+1)
  458.       IF strlength < stringwidth THEN cursor = cursor + 1
  459.       GOTO GetNewString
  460.     END IF
  461.     IF k=31 AND cursor > 0 THEN  ' cursor left
  462.       cursor = cursor-1
  463.      ELSEIF k=30 AND cursor < strlength THEN  ' cursor right
  464.        cursor = cursor+1
  465.      ELSEIF k = 127 AND cursor < strlength THEN  ' delete character 
  466.        strlength = strlength-1
  467.        a$ = LEFT$(a$,cursor) + MID$(a$,cursor+2)
  468.      ELSEIF k=8 AND cursor> 0 THEN  ' backspace delete-left
  469.        cursor = cursor-1: strlength = strlength-1
  470.      a$ = LEFT$(a$,cursor) + MID$(a$,cursor+2)
  471.      END IF
  472.     GOTO display.line
  473.   
  474.   done.getnewstring:
  475.     LOCATE y,x: inout$ = a$
  476.     PRINT inout$ + SPACE$(stringwidth-LEN(inout$))
  477.     IF n.buttons = 0 THEN exit.requester
  478.     WHILE 1: GOSUB check.buttons: WEND ' Must exit using buttons  
  479.         
  480.   check.buttons:
  481.     WHILE MOUSE(0) = 0  ' Mouse not pressed, check keyboard for first letters
  482.       k$ = UCASE$(INKEY$)
  483.       FOR b = 1 TO n.buttons
  484.       IF k$ = UCASE$(LEFT$(button$(b),1)) THEN
  485.         button% = b
  486.         GOTO exit.requester
  487.       END IF: NEXT
  488.     WEND
  489.     
  490.   IdentifyButton:  
  491.     xm = MOUSE(1): ym = MOUSE(2) ' Mouse was pressed, find which button 
  492.     IF ym > yb1 AND ym < yb2 THEN
  493.       FOR b = 1 TO n.buttons
  494.       IF xm > xb1(b) AND xm < xb2(b) THEN
  495.         AREA (xb1(b),yb1): AREA (xb1(b),yb2): AREA (xb2(b),yb2): AREA (xb2(b),yb1)
  496.         AREAFILL 1
  497.         WHILE MOUSE(0)<>0            ' Wait for button release
  498.         xm = MOUSE(1): ym = MOUSE(2) ' Check for cancel motion
  499.         IF ym < yb1 OR ym > yb2 OR xm < xb1(b) OR xm > xb2(b) THEN
  500.           AREA (xb1(b),yb1): AREA (xb1(b),yb2): AREA (xb2(b),yb2): AREA (xb2(b),yb1)
  501.           AREAFILL 1: RETURN
  502.         END IF: WEND
  503.       button% = b
  504.       GOTO exit.requester
  505.       END IF: NEXT b
  506.     END IF
  507.     RETURN
  508.     
  509.   exit.requester:
  510.     WINDOW CLOSE 100: COLOR 1,0
  511. END SUB '_______________________________________________________
  512.  
  513. SUB StringSep (InString$, Separate$, outstring$(1), i)  STATIC
  514.   temp$=InString$: i=0
  515.   WHILE temp$ <> ""
  516.     i=i+1: pointer = INSTR(temp$,Separate$)
  517.     IF pointer <> 0 THEN 
  518.       outstring$(i) = LEFT$(temp$,pointer-1)
  519.       temp$ = RIGHT$(temp$,LEN(temp$)-pointer)
  520.     ELSE
  521.       outstring$(i) = temp$: temp$="" 
  522.     END IF
  523.   WEND     
  524. END SUB  
  525.     
  526.                                                                               
  527.   
  528.